home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / out18com.zip / GETTIME.INC < prev    next >
Text File  |  1993-01-04  |  699b  |  31 lines
  1.  
  2. const gettime_tag: string[90]
  3.    = #0'@(#)CURRENT_FILE LAST_UPDATE Get time of day as real 1.1'#0;
  4. #log Get time of day as a real 1.1
  5.  
  6. (*
  7.  * gettime - get time of day from system clock
  8.  *
  9.  *)
  10.  
  11. function get_time: real;
  12. var
  13.    reg:  regpack;
  14.    time: real;
  15. begin
  16.    reg.ax := $2c00;          (* DOS get time function code *)
  17.    msdos( reg );
  18.  
  19.    with reg do
  20.    begin
  21.       time := int(lo(dx)) / 100.0 +   {seconds/100}
  22.               int(hi(dx)) +           {seconds}
  23.               int(lo(cx)) * 60.0 +    {minutes}
  24.               int(hi(cx)) * 3600.0;   {hours}
  25.  
  26.       {writeln(hi(cx),':',lo(cx),':',hi(dx),'.',lo(dx),'  ',time:0:2);}
  27.    end;
  28.  
  29.    get_time := time;
  30. end;
  31.